home *** CD-ROM | disk | FTP | other *** search
/ Action Arcade 1997 / Action Arcade 1997.iso / ps / unit16.pas < prev   
Pascal/Delphi Source File  |  1996-12-17  |  4KB  |  154 lines
  1. unit Unit16;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, DdeMan, StdCtrls, Buttons, FileCtrl, Gauges, ExtCtrls,fs;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Panel1: TPanel;
  12.     Image2: TImage;
  13.     Image1: TImage;
  14.     RCD: TImage;
  15.     Image3: TImage;
  16.     Image4: TImage;
  17.     Label1: TLabel;
  18.     Label2: TLabel;
  19.     Label3: TLabel;
  20.     ben: TGauge;
  21.     ScrollBox1: TScrollBox;
  22.     Image5: TImage;
  23.     Label4: TLabel;
  24.     Label5: TLabel;
  25.     Label6: TLabel;
  26.     flb1: TFileListBox;
  27.     flb2: TFileListBox;
  28.     flb3: TFileListBox;
  29.     dr: TComboBox;
  30.     BitBtn1: TBitBtn;
  31.     ComboBox1: TComboBox;
  32.     DdeClient: TDdeClientConv;
  33.     procedure Image3MouseDown(Sender: TObject; Button: TMouseButton;
  34.       Shift: TShiftState; X, Y: Integer);
  35.     procedure Image3MouseUp(Sender: TObject; Button: TMouseButton;
  36.       Shift: TShiftState; X, Y: Integer);
  37.     procedure Image4Click(Sender: TObject);
  38.     procedure ComboBox1Change(Sender: TObject);
  39.     procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
  40.       Shift: TShiftState; X, Y: Integer);
  41.     procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
  42.       Shift: TShiftState; X, Y: Integer);
  43.     procedure BitBtn1Click(Sender: TObject);
  44.     procedure FormCreate(Sender: TObject);
  45.   private
  46.     { Private declarations }
  47.   public
  48.     { Public declarations }
  49.   end;
  50.  
  51. var
  52.   Form1: TForm1;
  53.   i:integer;
  54.   macro,name,s:string;
  55.   cmd:array[0..255] of char;
  56.  
  57. implementation
  58.  
  59. {$R *.DFM}
  60.  
  61. procedure TForm1.Image3MouseDown(Sender: TObject; Button: TMouseButton;
  62.   Shift: TShiftState; X, Y: Integer);
  63. begin
  64. image3.visible:=false;
  65. end;
  66.  
  67. procedure TForm1.Image3MouseUp(Sender: TObject; Button: TMouseButton;
  68.   Shift: TShiftState; X, Y: Integer);
  69. begin
  70. image3.visible:=true;
  71. strpcopy(cmd,s+'\'+flb2.items[0]);
  72. winexec(cmd,SW_ShowNormal);
  73.  
  74. end;
  75.  
  76. procedure TForm1.Image4Click(Sender: TObject);
  77. begin
  78. close;
  79. end;
  80.  
  81. procedure TForm1.ComboBox1Change(Sender: TObject);
  82. begin
  83. s:=combobox1.text;
  84. s:='\games\'+s;
  85. flb1.directory:=s;
  86. flb2.directory:=s;
  87. flb3.directory:=s;
  88. if flb1.items.count-1<0 then
  89.    image5.picture.loadfromfile('\ps.bmp')
  90.    else
  91.    image5.picture.loadfromfile(s+'\'+flb1.items[0]);
  92.  
  93. end;
  94.  
  95. procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  96.   Shift: TShiftState; X, Y: Integer);
  97. begin
  98. IMAGE1.VISIBLE:=FALSE;
  99. end;
  100.  
  101. procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  102.   Shift: TShiftState; X, Y: Integer);
  103. begin
  104. IMAGE1.VISIBLE:=TRUE;
  105. dr.visible:=true;
  106. height:=464;
  107. end;
  108.  
  109. procedure TForm1.BitBtn1Click(Sender: TObject);
  110. begin
  111. try
  112.    caption:=dr.text+s;
  113.    mkdir(dr.text+'\games')
  114.    except
  115.    try mkdir(dr.text+s)
  116.        finally {}
  117.    end;
  118. end;
  119.  
  120. if s<>'' then
  121. begin
  122.      for i:=0 to flb3.items.count-1 do
  123.      Begin
  124.      ben.visible:=true;
  125.      ben.progress:=round(i*100/(flb3.items.count-1));
  126.      copyfile(s+'\'+flb3.items[i],dr.text+s);
  127.      End;
  128.      ben.visible:=false;
  129.  
  130.      begin
  131.      Name := 'Games';
  132.      Macro := Format('[CreateGroup(%s)]', [Name]) + #13#10;
  133.      StrPCopy (Cmd, Macro);
  134.      DDEClient.OpenLink;
  135.      if not DDEClient.ExecuteMacro(Cmd, False) then
  136.      MessageDlg('Unable to create group.', mtInformation, [mbOK], 0);
  137.      Macro := Format('[Additem(%s)]', [s+'\'+flb2.items[0]+','+combobox1.text+','+s+'\'+flb2.items[0]])+ #13#10;
  138.      StrPCopy (Cmd, Macro);
  139.      if not DDEClient.ExecuteMacro(Cmd, False) then
  140.         MessageDlg('Unable to Add Item.', mtInformation, [mbOK], 0);
  141.      DDEClient.CloseLink;
  142.      end;
  143. height:=401;
  144. end;
  145.  
  146. end;
  147.  
  148. procedure TForm1.FormCreate(Sender: TObject);
  149. begin
  150. flb2.directory:='\games';
  151. end;
  152.  
  153. end.
  154.